home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Count the 197045172001.psc / modSubDirs.bas < prev    next >
Encoding:
BASIC Source File  |  2001-05-17  |  1.1 KB  |  41 lines
  1. Attribute VB_Name = "modSubDirs"
  2. Option Explicit
  3.  
  4. Public Function GetAllDirsFrom(ByVal pstrDir As String, ByVal Extension As String, ByVal ListBox As ListBox)
  5.     
  6. Dim fso As FileSystemObject
  7. Dim fldrMain As Folder
  8. Dim fldrsSub As Folders
  9. Dim fldr As Folder
  10.     
  11.   Set fso = CreateObject("Scripting.FileSystemObject")
  12.   Set fldrMain = fso.GetFolder(pstrDir & "\")
  13.   
  14.   If Right(fldrMain.Path, 1) = "\" Then
  15.       AddAllFilesFrom Left(fldrMain.Path, Len(fldrMain.Path) - 1), Extension, ListBox
  16.   Else
  17.       AddAllFilesFrom fldrMain.Path, Extension, ListBox
  18.   End If
  19.   
  20.   ' Recurse subdirectories
  21.   Set fldrsSub = fldrMain.SubFolders
  22.   For Each fldr In fldrsSub
  23.       GetAllDirsFrom fldr.Path, Extension, ListBox
  24.   Next
  25.   
  26.   ListBox.Refresh
  27.   
  28. End Function
  29.  
  30. Public Function AddAllFilesFrom(ByVal pstrDir As String, ByVal Extension As String, ByVal ListBox As ListBox)
  31.  
  32. Dim strfile
  33.  
  34.   strfile = pstrDir & "\" & Dir(pstrDir & "\*." & Extension)
  35.   Do Until strfile = pstrDir & "\"
  36.     ListBox.AddItem strfile
  37.     strfile = pstrDir & "\" & Dir
  38.   Loop
  39.     
  40. End Function
  41.